home *** CD-ROM | disk | FTP | other *** search
/ Dr. Windows 3 / dr win3.zip / dr win3 / PROGRAMR / MWCC03.ZIP / MESSAGE.ZIP / MSGUNIT.PAS < prev   
Pascal/Delphi Source File  |  1993-08-18  |  27KB  |  855 lines
  1. {**********************************************************************}
  2. {*                                                                    *}
  3. {*          Microworks Sample Application                                        *}
  4. {*                                                                    *}
  5. {*         for Borland Pascal v7.0 and Turbo Pascal for Windows v1.5           *}
  6. {*                                                                    *}
  7. {*     Copyright 1992-93 Jeff Franks (Microworks) Sydney, Australia.  *}
  8. {*                                                                    *}
  9. {*         You are free to use, modify, reproduce and distribute the      *}
  10. {*         Sample Files (and/or any modified version) in any way you      *}
  11. {*         find useful.                                                                *}
  12. {*                                                                    *}
  13. {**********************************************************************}
  14.  
  15. {*** Introduction
  16.  
  17.     Unit           := MsgUnit
  18.  
  19.     Files          := Msgunit.pas
  20.  
  21.     Units Required := MWCC.dll
  22.  
  23.     Tabs           := 2
  24.  
  25.     Screen         := 800 * 600
  26.  
  27.     Date           := August, 1993.
  28.  
  29.     MsgUnit is the complete source code for the MWCC and SFX message boxes. It includes
  30.     the drawing, painting and keydown procedures from MWCC.dll (not found in MMsgBox.pas
  31.     in RTL.ZIP). I've included this source code as an example of how to write a non-OWL
  32.     application should the need arise - like in a DLL.
  33.  
  34. {*** About the Message Box unit
  35.  
  36.     I rewrote to OWL MWCC and SFX message boxes from the previous version (in the MWCC unit in
  37.     MWCC02.ZIP) because I wanted to put the message boxes in MWCC.dll. Initially I rewrote
  38.     the message boxes using the DLLAPP.ZIP sample found in the BPascal forum's OWL library
  39.     (No 8). It worked great - 90% of the time, but every now and then I got a general
  40.     protection fault. The best I could do to trace the fault was to the behind the scenes
  41.     TWindowsObject.GetObjectPtr routine for the dummy DLLAPP Window. After weeks of hasle I
  42.     decided it would be quicker to rewrite the message boxes without Object Windows. One week
  43.     later and everything was working well. Best of all the exe files were about 4-5k smaller.
  44.  
  45.     Then I hit another problem. You can't have multiple instances in a DLL. Because only one
  46.     instance of a dll is ever loaded, the second instance of an application that is run from
  47.     a DLL overwrites the data for the first instance. When you close the second instance your
  48.     left with the first instance and no data. This leaves you    with is a window shell that
  49.     doesn't know what to do with itself.
  50.  
  51.     I managed to find a multiple instance DLL that uses assembly code to keep a list of tasks.
  52.     Each new task that uses the DLL gets its own data segment. Unfortunaltely, it would have
  53.     taken too long to rewrite the message boxes a third time so I left that until the next
  54.     version.
  55.  
  56.     MsgUnit imports the MWCC.dll procedures and functions it needs itself, so it doesn't need
  57.     MObjects.
  58.  
  59.     One advantage of using generic Pascal programming to write a Windows program is that it
  60.     produces a smaller exe file.
  61.  
  62.     When reading through the code everything is more or less upside down compared to an OWL
  63.     program because functions and procedures must be declared before they can be used. you might
  64.     find it easier to start at the bottom - at the MsgBoxWinMain procedure.
  65.  
  66.     The code might look a little more complicated (or messy) because it is used to display two
  67.     different types of message boxes.
  68.  
  69.     To use this unit compile it and then compile and run the Msgtest program.
  70.  
  71.     I hope you find this unit useful.
  72.  
  73.     Jeff...
  74.  
  75. ***}
  76.  
  77. unit MsgUnit;
  78.  
  79. interface
  80.  
  81. uses WinProcs, WinTypes;
  82.  
  83. type
  84.  
  85.     TMinMaxInfo = array [0..4] of TPoint;
  86.     PMinMaxInfo = ^TMinMaxInfo;
  87.  
  88.     function  MWCCMsgBox (WndParent: HWnd; ATxt, ACaption: PChar; ATextType: Word;
  89.                                                 ABmp: PChar): Integer;
  90.  
  91.     function  SFXMsgBox (WndParent: HWnd; ATxt, ACaption: PChar; ATextType: Word): Integer;
  92.  
  93.     function  CreateDefaultFont (IsBold: Boolean): HFont;
  94.  
  95.     procedure Draw3DBorder (Wnd: HWnd; X, Y, W, H: Integer; Shade: Word);
  96.  
  97.     procedure DrawSFXFrame (Wnd: HWnd);
  98.  
  99. implementation
  100.  
  101. const
  102.  
  103.     ctl_Recessed = 51;
  104.     ctl_Raised   = 52;
  105.  
  106. var
  107.  
  108.     Default1    : Boolean;
  109.     Default2    : Boolean;
  110.     Default3    : Boolean;
  111.     SFXStyle    : Boolean;
  112.     BkBmp       : HBitmap;
  113.     MsgBmp      : HBitmap;
  114.     UpBmp1      : HBitmap;
  115.     UpBmp2      : HBitmap;
  116.     UpBmp3      : HBitmap;
  117.     BkBrush     : HBrush;
  118.     LastWnd     : HWnd;
  119.     MsgBoxWnd   : HWnd;
  120.     WndButton1  : HWnd;
  121.     WndButton2  : HWnd;
  122.     WndButton3  : HWnd;
  123.     ID1         : Integer;
  124.     ID2         : Integer;
  125.     ID3         : Integer;
  126.     a           : Integer;
  127.     b           : Integer;
  128.     c           : Integer;
  129.     d           : Integer;
  130.     e           : Integer;
  131.     f           : Integer;
  132.     Reply       : Integer;
  133.     ButtonProc1 : TFarProc;
  134.     ButtonProc2 : TFarProc;
  135.     ButtonProc3 : TFarProc;
  136.     OldProc1    : TFarProc;
  137.     OldProc2    : TFarProc;
  138.     OldProc3    : TFarProc;
  139.     HLib        : THandle;
  140.     MWCCWndHdl  : THandle;
  141.     SFXWndHdl   : THandle;
  142.     WinRect     : TRect;
  143.     TextType    : Word;
  144.     szText      : array[0..255] of Char;
  145.     szTitle     : array[0..50] of Char;
  146.  
  147. function  CreateDefaultFont; external 'MWCC' Index 1;
  148.  
  149. procedure Draw3DBorder; external 'MWCC' Index 5;
  150.  
  151. procedure DrawSFXFrame; external 'MWCC' Index 10;
  152.  
  153. procedure DrawMsgBoxButton (Wnd: HWnd; lParam: LongInt);
  154. {*** From MWCC.dll
  155.  
  156.     Draws the Message box buttons. It's a bit slow when launching the message box
  157.     because it loads each bitmap as it needs it. To overcome this the bitmaps that
  158.     need to be displayed initially (the up bitmaps) are loaded before the window is
  159.     constructed.
  160.  
  161. ***}
  162. var
  163.     Down      : Boolean;
  164.     Up        : Boolean;
  165.     Other     : Boolean;
  166.     Bitmap    : HBitmap;
  167.     MemDC     : HDC;
  168.     Offset    : Integer;
  169.     OldObject : THandle;
  170. begin
  171.     with pDrawItemStruct(lParam)^, rcItem do
  172.         case CtlType of
  173.             odt_Button:
  174.             begin
  175.                 if ItemAction = oda_Focus then exit;
  176.                 Down := ((ItemAction and oda_Select) > 0) and ((ItemState and ods_Selected) > 0);
  177.                 Up := ((ItemAction and oda_Select) > 0) and ((ItemState and ods_Selected) = 0);
  178.                 Other := ((ItemAction and oda_Select) = 0) and ((ItemState and ods_Selected) = 0);
  179.                 FillRect(HDC, rcItem, GetStockObject(LtGray_Brush));
  180.                 Draw3DBorder(HWndItem, Left, Top, Right-Left, Bottom-Top, ctl_Recessed);
  181.                 MemDC := CreateCompatibleDC(HDC);
  182.                 if (GetFocus = HWndItem) then
  183.                 begin
  184.                     if Down then
  185.                         OffSet := 3000
  186.                     else
  187.                         OffSet := 5000;
  188.                 end
  189.                 else
  190.                 begin
  191.                     if Down then
  192.                         OffSet := 3000
  193.                     else
  194.                     if Up then
  195.                         OffSet := 5000
  196.                     else
  197.                     if Other then
  198.                         OffSet := 1000;
  199.                 end;
  200.                 Bitmap := LoadBitmap(HLib, PChar(OffSet + CtlID));
  201.                 OldObject := SelectObject(MemDC, Bitmap);
  202.                 BitBlt(HDC, Left, Top, Right-Left, Bottom-Top, MemDC, 0, 0, SrcCopy);
  203.                 SelectObject(MemDC, OldObject);
  204.                 DeleteObject(Bitmap);
  205.                 DeleteDC(MemDC);
  206.             end;
  207.         end;
  208. end;
  209.  
  210. procedure MsgBoxKeyDown (ParentWnd, Wnd: HWnd; wParam: Word);
  211. {*** From MWCC.dll
  212.  
  213.     MsgBoxKeyDown handles tabbing through the buttons. Because the message box is a window
  214.     and not a dialog tabbing doesn't automatically occur. EnableKBHandler can't be used here
  215.     because this is a non_OWL program.
  216.  
  217. ***}
  218. var
  219.     SibWnd : HWnd;
  220.     lStyle : LongInt;
  221.     ID     : Word;
  222. begin
  223.     SibWnd := 0;
  224.     ID := GetDlgCtrlID(Wnd);
  225.     case wParam of
  226.         vk_Return :
  227.         begin
  228.             SendMessage(MsgBoxWnd, wm_Command, ID, ID + bn_Clicked);
  229.             Exit;
  230.         end;
  231.     end;
  232.     while SibWnd = 0 do
  233.     begin
  234.         if ID = 7 then
  235.             ID := 1
  236.         else
  237.             ID := ID + 1;
  238.         SibWnd := GetDlgItem(MsgBoxWnd, ID);
  239.         lStyle := GetWindowLong (SibWnd, gwl_Style);
  240.         if not (lStyle = lStyle or ws_TabStop) then
  241.             SibWnd := 0;
  242.     end;
  243.     case wParam of
  244.         vk_Tab:
  245.         begin
  246.             SetFocus(SibWnd);
  247.             InvalidateRect(Wnd, nil, True);
  248.             InvalidateRect(SibWnd, nil, True);
  249.         end;
  250.     end;
  251. end;
  252.  
  253. procedure PaintMsgBox (Wnd: HWnd; AText: PChar; Ofs1, Ofs2, Ofs3: Integer;
  254.                                              MsgBmp: HBitmap; SFXStyle: Boolean);
  255. {*** From MWCC.dll
  256.  
  257.     PaintMsgBox handles all t